home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48_1 / pubdom.tar / pubdom / rbj / geom < prev    next >
Text File  |  1990-05-09  |  4KB  |  79 lines
  1. %%HP: T(3)A(D)F(.);
  2. @  GEOM  Geometric, Dimension Programs
  3. @  RBJ 5/09/90  Extracted from HP28.  Improved Comments, Used Implicit
  4. @               Numeric to String Conversion, RFR speeded up: Used 
  5. @               explicit divide and swap vs C->R stuff
  6. @
  7. DIR
  8.     @
  9.     @ Functions to Display Feet Inch and Fraction
  10.     @  
  11.   DF \<<                                    @ Number in decimal feet 
  12.     DUP tFIF "\010" + 
  13.     1 DISP 1 FREEZE \>>
  14.  
  15.   INFF \<<                                  @ For number in decimal inches
  16.     DUP 12 /                                @ Copy to remain, convert to feet, 
  17.     DF DROP \>>                             @ Run DF, DROP Feet  
  18.  
  19.   CFIF \<<                                  @ X and Y of complex pair (Feet)
  20.     DUP C\->R SWAP                          @ Copy to Remain, Do X first
  21.     tFIF "\010" +                           @ Display X on L1, Clear Line 2
  22.          "X= " SWAP + 1 DISP
  23.     tFIF "Y= " SWAP + 2 DISP                @ Display Y on L2 
  24.     1 FREEZE \>>
  25.  
  26.   P2AB \<<    @ Given two (X,Y) points, returns (a,b) : the terms of the 
  27.               @  equation of the line between the two points:  y = ax +b.
  28.     DUP ROT - C\->R SWAP / DUP 
  29.     ROT C\->R ROT ROT * - R\->C \>>
  30.  
  31.   EQXY \<<    @ Given the equation of two lines (a,b) on the stack, 
  32.               @ returns the intersection point (X,Y).
  33.     OVER - C\->R NEG SWAP / ABXY \>>
  34.  
  35.   ABXY \<<    @ Given an equation of a line (a,b) and an X coordinate, 
  36.               @ returns the point (X,Y) on the line.
  37.     SWAP C\->R SWAP 3 PICK * + R\->C \>>
  38.  
  39.   FRC 16                                    @  Fractional Precision such as
  40.                                             @   8, 16,or 32 (User Adjustable)
  41.  
  42.   @  Guts of Program: Replaces Top of Stack number in decimal feet with 
  43.   @  character string representation in feet inches and fraction.
  44.  
  45.   tFIF \<<
  46.     RCLF STD                                @ Save Flags, set STD mode
  47.     SWAP ABS 12 *                           @ Convert to POSITIVE Inches
  48.     FRC * 0 RND                             @ Round to Integral FRCs
  49.     FRC MD                                  @ X frcs, N inch
  50.     12  MD                                  @ X frc, Y inch, Z feet
  51.     "' " + SWAP                             @ Implied Conversion: "Feet' "
  52.     + SWAP                                  @ "Feet' Inch"
  53.     FRC SWAP FRS +                          @ Add Fraction String
  54.     34 CHR +                                @ Add Quote for Inch
  55.     SWAP STOF  \>>                          @ Restore Flags
  56.  
  57.   MD \<<                                    @  Integer Divide and Remainder 
  58.     MOD LASTARG / IP \>>                    @  Num Denom -> Rem Quo
  59.  
  60.   FRS \<<                                   @ Convert fraction to a string.
  61.     DUP                                     @ Denom Numer
  62.     IF 0 ==                                 @ Null string if Numer = 0
  63.     THEN DROP2 "" 
  64.     ELSE RFR                                @ Reduce fraction
  65.          "/" +                              @ Denom "Numer/"
  66.          SWAP +                             @ "Numer/Denom"
  67.          "-" SWAP +                         @ "-Numer/Denom"
  68.     END  \>>
  69.  
  70.   RFR \<<                                   @ Reduces to lowest fraction  
  71.     IF DUP 2 MOD NOT                        @ (Numer in 1, Denom in 2)
  72.     THEN 2 / SWAP 2 / SWAP                  @ Divide both by 2 if Numer EVEN
  73.          RFR                                @ Recursion!
  74.     END \>>
  75.  
  76.  
  77. END
  78.  
  79.